home *** CD-ROM | disk | FTP | other *** search
/ Apple II Magazines (DO) / A+ Disk Magazine Volume 1, No. 1 (1984)(Ziff-Davis).zip / A+ Disk Magazine Volume 1, No. 1 (1984)(Ziff-Davis).do / SHAPE MAKER.bas < prev    next >
BASIC Source File  |  1996-12-24  |  10KB  |  235 lines
  1. 1  HOME : VTAB 8: HTAB 12: PRINT "A+ DISK MAGAZINE"
  2. 2  VTAB 10: HTAB 16: PRINT "PRESENTS"
  3. 3  VTAB 12: HTAB 13: INVERSE : PRINT " SHAPE MAKER ": NORMAL 
  4. 4  FOR I = 1 TO 500: NEXT I
  5. 5  VTAB 15: HTAB 19: PRINT "BY"
  6. 7  VTAB 17: HTAB 13: PRINT "JASON WINSHELL"
  7. 8  VTAB 23: HTAB 22: PRINT "(C)COPYRIGHT 1983"
  8. 9  FOR I = 1 TO 4000: NEXT I
  9. 10  TEXT : HOME : DIM F$(255)
  10. 20 FALSE = 0:TRUE = 1:IMEXIST = FALSE:SA = 24576:SH = 25600:ST = SH -4: GOSUB 10000: GOSUB 11000
  11. 450  TEXT : HOME 
  12. 490  PRINT : PRINT "THE FOLLOWING OPTIONS ARE AVAILABLE"
  13. 500  PRINT "TO YOU ..."
  14. 510  PRINT : PRINT : PRINT "1. DEFINE NEW SHAPES (OLD LOST)"
  15. 520  PRINT : PRINT "2. VIEW": PRINT : PRINT "3. STORE TO DISK"
  16. 540  PRINT : PRINT "4. RETRIEVE OLD SHAPE FILE": PRINT : PRINT "5. PRINT DECIMAL POKE DATA"
  17. 560  PRINT : PRINT "6. GROUP SHAPE FILES"
  18. 570  PRINT : PRINT "7. EXIT": PRINT 
  19. 580  VTAB (22): HTAB 1: CALL  -868: PRINT "CHOOSE# (1-7):";: GET C$:C% =  VAL(C$)
  20. 590  IF (C% >0)  AND (C% <8)  THEN 610
  21. 600  VTAB (20): GOTO 580
  22. 610  IF ((C% = 2)  OR (C% = 3)  OR (C% = 5))  AND (IMEXIST = FALSE)  THEN ERMSS$ = "NO IMAGE DEFINED IN MEMORY": GOSUB 9000: GOTO 580
  23. 620  HOME : ON C% GOSUB 3000,2000,1000,6000,7000,8000,20000
  24. 630  GOTO 450
  25. 1000  HOME : INPUT "SAVE TO FILE NAME >>";F$: IF F$ = ""  THEN  RETURN 
  26. 1010 F$ = F$ +".SHAPE": IF ( ASC( MID$ (F$,1,1)) <65)  OR ( ASC( MID$ (F$,1,1)) >90)  THEN ERMSS$ = "ILLEGAL FILE NAME FORMAT": GOSUB 9000: GOTO 1060
  27. 1020  ONERR  GOTO 1040
  28. 1030  PRINT  CHR$(4);"BSAVE ";F$;",A";SH;",L";BYTES: POKE 216,0: RETURN 
  29. 1040  POKE 216,0:ERMSS$ = "DISK ERROR": GOSUB 9000: GOTO 450
  30. 2000  HGR : HCOLOR= 3: VTAB 21: HTAB 1: CALL  -958:LX = 139:LY = 80: ROT= 0: SCALE= 1:R% = 0:S% = 1
  31. 2010  HCOLOR= 3: DRAW 1 AT LX,LY:XP = LX:YP = LY
  32. 2020  VTAB 21: HTAB 1: CALL  -868: PRINT "ROT =";R%;: HTAB 10: PRINT "SCALE =";S%;: HTAB 25: PRINT "DRAW AT ";LX;",";LY;
  33. 2030  GET A$
  34. 2040  IF A$ =  CHR$(13)  THEN  RETURN 
  35. 2050  IF A$ = "R"  THEN I = 1: GOTO 2140
  36. 2060  IF A$ = "C"  THEN I = 2: GOTO 2140
  37. 2070  IF A$ = "S"  THEN I = 3: GOTO 2140
  38. 2080  IF A$ = "X"  THEN I = 4: GOTO 2140
  39. 2090  IF A$ = "O"  THEN I = 5: GOTO 2140
  40. 2100  IF A$ = ","  THEN I = 6: GOTO 2140
  41. 2110  IF A$ = "K"  THEN I = 7: GOTO 2140
  42. 2120  IF A$ = "L"  THEN I = 8: GOTO 2140
  43. 2130  GOTO 2030
  44. 2140  HPLOT LX,LY: ON I GOTO 2150,2170,2190,2210,2230,2250,2270,2290
  45. 2150  IF R% <255  THEN R% = R% +1
  46. 2160  GOTO 2300
  47. 2170  IF R% >0  THEN R% = R% -1
  48. 2180  GOTO 2300
  49. 2190  IF S% <255  THEN S% = S% +1
  50. 2200  GOTO 2300
  51. 2210  IF S% >1  THEN S% = S% -1
  52. 2220  GOTO 2300
  53. 2230  IF LY >0  THEN LY = LY -1
  54. 2240  GOTO 2300
  55. 2250  IF LY <159  THEN LY = LY +1
  56. 2260  GOTO 2300
  57. 2270  IF LX >0  THEN LX = LX -1
  58. 2280  GOTO 2300
  59. 2290  IF LX <279  THEN LX = LX +1
  60. 2300  HCOLOR= 0: DRAW 1 AT XP,YP
  61. 2310  ROT= R%: SCALE= S%
  62. 2320  GOTO 2010
  63. 2330  RETURN 
  64. 3000  GOSUB 5000: IF A$ =  CHR$(27)  THEN  RETURN 
  65. 3010  VTAB 21: HTAB 1: CALL  -958: FLASH : PRINT "PLEASE WAIT, SCANNING";: NORMAL : GOSUB 4000
  66. 3020  HGR : HCOLOR= 3: SCALE= 1: ROT= 0: DRAW 1 AT 139,80: VTAB 21: HTAB 1: CALL  -958: HTAB 15: PRINT BYTE;" BYTES CREATED"
  67. 3030  HTAB 1: CALL  -868: FOR I = 1 TO 1500: NEXT I:IMEXIST = TRUE: RETURN 
  68. 4000 BSEC = 0:BYTES = 1:SEC = 0: CALL  -958: POKE SH -1 +BYTE,0
  69. 4010  FOR I = SA +1 TO SA +VCTS
  70. 4020 SEC = 0:J =  PEEK(I)
  71. 4030  IF J > = 128  THEN SEC = SEC +4:J = J -128
  72. 4040  IF J = 79  THEN SEC = SEC +0: GOTO 4080
  73. 4050  IF J = 44  THEN SEC = SEC +2: GOTO 4080
  74. 4060  IF J = 75  THEN SEC = SEC +3: GOTO 4080
  75. 4070 SEC = SEC +1
  76. 4080  IF BSEC = 3  THEN BSEC = 0:BYTES = BYTES +1: POKE SH -1 +BYTE,0
  77. 4090  IF (SEC > = 4)  AND (BSEC = 2)  THEN BSEC = 0:BYTE = BYTE +1: POKE SH -1 +BYTE,0
  78. 4100  IF SEC < >0  THEN 
  79. 4110  IF SEC < >0  THEN 4160
  80. 4120  IF BSEC < >0  THEN BSEC = 0:BYTE = BYTE +1: POKE SH -1 +BYTE,0
  81. 4130  POKE (SH -1) +BYTE,193
  82. 4140 BSEC = 2
  83. 4150  GOTO 4200
  84. 4160  IF BSEC = 0  THEN PWR = 0: GOTO 4190
  85. 4170  IF BSEC = 1  THEN PWR = 3: GOTO 4190
  86. 4180 PWR = 6
  87. 4190  POKE SH -1 +BYTE, PEEK(SH -1 +BYTE) +SEC *2 ^PWR
  88. 4200 BSEC = BSEC +1
  89. 4210  NEXT I
  90. 4220 BYTE = BYTE +1
  91. 4230  POKE SH -1 +BYTE,0
  92. 4240  RETURN 
  93. 5000  HGR : HCOLOR= 3:CL = 1: GOSUB 5310: GOSUB 5390
  94. 5010  IF A$ =  CHR$(27)  THEN  RETURN 
  95. 5020  HOME : VTAB 21: HTAB 1
  96. 5030  PRINT "DIRECTION, <SB>, <ESC>, P, E, OR F";
  97. 5040  VTAB 22: HTAB 1: PRINT "PEN ";:P = 1: GOSUB 5200: GOSUB 5770
  98. 5050  GOSUB 5480
  99. 5060  IF A$ = "N"  THEN  GOSUB 5520: GOTO 5050
  100. 5070  GOSUB 5550
  101. 5080  IF A$ = "P"  THEN P =   NOT (P): GOSUB 5200: GOTO 5050
  102. 5090  IF A$ =  CHR$(32)  THEN  GOSUB 5560: GOTO 5050
  103. 5100  IF A$ = "E"  THEN  HOME : POP : GOTO 3000
  104. 5110  IF (A$ = "F")  OR (A$ =  CHR$(27))  THEN  RETURN 
  105. 5120  GOSUB 5240
  106. 5130  IF (A$ < >"O")  AND (A$ < >",")  AND (A$ < >"K")  AND (A$ < >"L")  THEN 5050
  107. 5140  IF VCTS = 1024  THEN 5050
  108. 5145  IF CHG = FALSE  THEN 5050
  109. 5150  IF P = 0  THEN 5170
  110. 5160  HPLOT  TO XP *5,(150 -5 *YP)
  111. 5170 VCTS = VCTS +1: POKE SA +VCTS, ASC(A$) +P *128
  112. 5180  GOSUB 5770
  113. 5190  GOTO 5050
  114. 5200  INVERSE : VTAB 22: HTAB 5
  115. 5210  IF P = 1  THEN  PRINT "ON ";: GOTO 5230
  116. 5220  PRINT "OFF";
  117. 5230  NORMAL : RETURN 
  118. 5240  IF VCTS = 1024  THEN  RETURN 
  119. 5250 CHG = TRUE: IF A$ = "O"  AND YP < >30  THEN YP = YP +1: GOTO 5290
  120. 5260  IF A$ = ","  AND YP < >0  THEN YP = YP -1: GOTO 5290
  121. 5270  IF A$ = "K"  AND XP < >0  THEN XP = XP -1: GOTO 5290
  122. 5280  IF A$ = "L"  AND XP < >55  THEN XP = XP +1
  123. 5290  IF (XP = LX)  AND (YP = LY)  THEN CHG = FALSE
  124. 5300 LX = XP:LY = YP: RETURN 
  125. 5310  HGR 
  126. 5320  HCOLOR= 3
  127. 5330  FOR Y = 0 TO 150  STEP 5
  128. 5340  FOR X = 0 TO 275  STEP 5
  129. 5350  HPLOT X,Y
  130. 5360  NEXT X,Y
  131. 5370 VCTS = 0:CL = 1
  132. 5380  RETURN 
  133. 5390  HOME 
  134. 5400  VTAB 21: HTAB 1: PRINT "USE DIRECTIONAL PAD TO LOCATE START"
  135. 5410 XP = 28:YP = 15:LX = 28:LY = 15: GOSUB 5770
  136. 5420  GOSUB 5480: IF A$ = "N"  THEN  GOSUB 5520: GOTO 5420
  137. 5430  GOSUB 5550: GOSUB 5240
  138. 5440  HPLOT XP *5,(150 -YP *5)
  139. 5450  GOSUB 5770
  140. 5460  IF (A$ =  CHR$(13))  OR (A$ =  CHR$(27))  THEN  RETURN 
  141. 5470  GOTO 5420
  142. 5480 A =  PEEK( -16384): POKE  -16368,0
  143. 5490  IF A <128  THEN A$ = "N": RETURN 
  144. 5500 A = A -128:A$ =  CHR$(A)
  145. 5510  RETURN 
  146. 5520 CL =   NOT (CL): HCOLOR= 3 *CL
  147. 5530  HPLOT LX *5,(150 -5 *LY)
  148. 5540  RETURN 
  149. 5550 CL = 1: HCOLOR= 3 *CL: HPLOT LX *5,(150 -5 *LY): RETURN 
  150. 5560  IF VCTS = 0  THEN  RETURN 
  151. 5570 I =  PEEK(SA +VCTS)
  152. 5590  HCOLOR= 0
  153. 5600  IF I = 204  THEN 5730
  154. 5610  IF I = 207  THEN 5690
  155. 5620  IF I = 203  THEN 5710
  156. 5630  IF I = 172  THEN 5670
  157. 5640  IF I = 76  THEN 5740
  158. 5650  IF I = 79  THEN 5700
  159. 5660  IF I = 75  THEN 5720
  160. 5665  GOTO 5680
  161. 5670  HPLOT XP *5,150 -YP *5 -1 TO XP *5,150 -(YP +1) *5 +1
  162. 5680 YP = YP +1: GOTO 5750
  163. 5690  HPLOT XP *5,150 -YP *5 +1 TO XP *5,150 -(YP -1) *5 -1
  164. 5700 YP = YP -1: GOTO 5750
  165. 5710  HPLOT XP *5 +1,150 -YP *5 TO (XP +1) *5 -1,150 -YP *5
  166. 5720 XP = XP +1: GOTO 5750
  167. 5730  HPLOT XP *5 -1,150 -YP *5 TO (XP -1) *5 +1,150 -YP *5
  168. 5740 XP = XP -1
  169. 5750 VCTS = VCTS -1:LX = XP:LY = YP
  170. 5760  GOSUB 5770: RETURN 
  171. 5770  VTAB 24: HTAB 1
  172. 5780  CALL  -868
  173. 5790  PRINT "VECTORS : ";VCTS;: HTAB 25: PRINT "CURSOR: ";XP;"  ";YP;: RETURN 
  174. 6000  PRINT : PRINT : PRINT "<CTRL-D>CAT"
  175. 6010  GET A$: HOME : INPUT "LOAD FILE>>";F$: IF F$ = ""  THEN  RETURN 
  176. 6020 F$ = F$ +".SHAPE": ONERR  GOTO 6050
  177. 6030  PRINT  CHR$(4);"BLOAD";F$;",A";SH
  178. 6040  POKE 216,0:IMEXIST = TRUE:BYTE =  PEEK(43616) +256 * PEEK(43617): RETURN 
  179. 6050  POKE 216,0:ERMSS$ = "DISK ERROR": GOSUB 9000: GOTO 450
  180. 7000  HOME : IF SN% = 0  THEN 7030
  181. 7010  PRINT "SEND TO PRINTER (Y/N) ";
  182. 7020  GET A$: IF (A$ < >"Y")  AND (A$ < >"N")  THEN 7020
  183. 7030  PRINT A$;: HOME : IF A$ = "Y"  THEN  PRINT  CHR$(4);"PR# ";SN%
  184. 7040  PRINT "DECIMAL DATA POKES :": PRINT 
  185. 7050  FOR I = SH TO SH +BYTE -1
  186. 7060  PRINT  PEEK(I)"  ";
  187. 7070  NEXT I
  188. 7080  PRINT : PRINT 
  189. 7090  PRINT "LENGTH: ";BYTES
  190. 7100  PRINT "STARTING ADDRESS: ";SH
  191. 7110  PRINT  CHR$(4);"PR# 0"
  192. 7120  PRINT : PRINT : PRINT "HIT A KEY TO ESCAPE ...";: GET T$: RETURN 
  193. 8000  PRINT : PRINT  CHR$(4);"CATALOG": GET A$
  194. 8010  HOME :IMEXIST = FALSE: GOSUB 10000:TS = 0:CHG = 0
  195. 8020  TEXT : PRINT "SHAPE #";TS +1;">>";: INPUT F$(TS): IF F$(TS) = ""  THEN 8090
  196. 8040 F$(TS) = F$(TS) +".SHAPE": ONERR  GOTO 8080
  197. 8050  PRINT  CHR$(4);"BLOAD";F$(TS);",A";SH
  198. 8060  HGR : ROT= 0: SCALE= 1: DRAW 1 AT 139,80: FOR LX = 0 TO 1000: NEXT LX
  199. 8070  POKE 216,0:TS = TS +1: IF TS < = 256  THEN 8020
  200. 8071  GOTO 8090
  201. 8080  POKE 216,0:CHG = 1:ERMSS$ = "DISK ERROR": GOSUB 9000: GOTO 8020
  202. 8090  IF TS = 0  AND   NOT (CHG)  THEN  RETURN 
  203. 8100  IF TS = 0  AND CHG  THEN 450
  204. 8110  TEXT : HOME :TS = TS -1
  205. 8120  POKE ST,TS +1: POKE ST +1,0:LX = 2 +2 *(TS +1) +ST
  206. 8130  FOR I = 0 TO TS
  207. 8140  PRINT  CHR$(4);"BLOAD";F$(I);",A";LX
  208. 8150 LY = LX -ST: POKE ST +2 *(I +1),LY -256 * INT(LY/256): POKE ST +2 *(I +1) +1, INT(LY/256)
  209. 8160 LX = LX + PEEK(43616) +256 * PEEK(43617)
  210. 8170  NEXT I
  211. 8180  INPUT "SAVE TO FILE >>";F$
  212. 8190  IF F$ = ""  THEN 8290
  213. 8200 LY = LX -ST +1: ONERR  GOTO 8280
  214. 8210  PRINT  CHR$(4);"BSAVE ";F$;",A";ST",L";LY: POKE 216,0
  215. 8220  PRINT : PRINT "A USABLE SHAPE TABLE OF ";TS +1;" SHAPES HAS": PRINT "BEEN SAVED."
  216. 8230  PRINT "STARTING ADDRESS :";ST
  217. 8240  PRINT "LENGTH :";LY
  218. 8250  PRINT : PRINT "IT MAY BE BLOADED ANYWHERE, BUT YOU"
  219. 8260  PRINT "MUST SET THE LOCATIONS E8,E9 HEX TO": PRINT "POINT TO THE BEGINNING OF THIS TABLE.": PRINT "CHECK YOU APPLESOFT BOOK FOR": PRINT "MORE INFORMATION."
  220. 8270  GET A$: GOTO 8290
  221. 8280  POKE 216,0:ERMSS$ = "DISK ERROR": GOSUB 9000: GOTO 450
  222. 8290  IF   NOT (CHG)  THEN  RETURN 
  223. 8300  GOTO 450
  224. 9000  VTAB 24: HTAB 1: INVERSE : PRINT ERMSS$;: FOR J = 1 TO 2000: NEXT : HTAB 1: NORMAL : CALL  -868: RETURN 
  225. 10000  POKE 232,ST -256 * INT(ST/256): POKE 233, INT(ST/256)
  226. 10010  POKE ST,1: POKE ST +1,0: POKE ST +2,4: POKE ST +3,0: RETURN 
  227. 11000  VTAB 8: PRINT "DO YOU HAVE A PRINTER (Y/N) ?";
  228. 11010  GET A$
  229. 11020  IF A$ < >"N"  AND A$ < >"Y"  THEN 11010
  230. 11030  PRINT A$: IF A$ = "N"  THEN SN% = 0: RETURN 
  231. 11040  PRINT "SLOT (1-6) ?";
  232. 11050  GET A$
  233. 11060  IF  VAL(A$) <1  OR  VAL(A$) >6  THEN 11050
  234. 11070  PRINT A$:SN% =  VAL(A$): RETURN 
  235. 20000  HOME : END